perm filename DIGTIZ.SAI[PIX,HPM]1 blob sn#373831 filedate 1978-08-15 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "DIGTIZ"
C00009 ENDMK
C⊗;
BEGIN "DIGTIZ"
INTEGER NRT,P2,JOBNO;  INTEGER I,J,NPX,NSU,TI;  REAL REDUN; STRING S;
INTEGER BCL,TCL,SUMS,XEE,YEE,NRTRY;  INTEGER CAMRA,CAM,HIG,WID,BIT;
STRING FND,FN1,FN2,FNP,FNR;
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
INTEGER ARRAY MESSAGE[1:32], HD[1:2];

S←""; S←S[1 TO 1]; comment forces SUBST to be loaded;

WHILE TRUE DO
   BEGIN "WAIT"
      START_CODE MAIL 1,ACCESS(MESSAGE[1]); comment WRCV; END;
IFC FALSE THENC
   HIG←260; WID←288; BIT←7;
   CAMERA←'54;
   YEE←0; XEE←1;
   BCL←7; TCL←0;
   SUMS←1;
   REDUN←2.5;
ENDC
   JOBNO←MESSAGE[1];
   HIG←MESSAGE[2]; WID←MESSAGE[3]; BIT←MESSAGE[4];
   CAMRA←MESSAGE[5];
   YEE←MESSAGE[6]; XEE←MESSAGE[7];
   BCL←MESSAGE[8]; TCL←MESSAGE[9];
   SUMS←MESSAGE[10];
   REDUN←MEMORY[LOCATION(MESSAGE[11]),REAL];
   FND←CV6STR(MESSAGE[12]);
   FN1←CV6STR(MESSAGE[13]);
   FN2←CV6STR(MESSAGE[14]);
   FNP←CV6STR(MESSAGE[15]);
   FNR←CV6STR(MESSAGE[16]);

      HD[1]←JOBNO;
      HD[2]←LOCATION(MESSAGE[1]);

      START_CODE MAIL 0,ACCESS(HD[1]); comment SEND; JRST .+1; END;

   IF CAMRA>'40 THEN CAMRA←CAMRA LAND '67;
   IF CAMRA='42∨CAMRA='41 THEN CAM←CAMRA LAND 3 ELSE
      BEGIN
      INTEGER I,J;
      I←'401400000000 LOR LOCATION(J);
      J←IF CAMRA≥'40 THEN CAMRA LAND 7 ELSE 1 LSH (35-CAMRA);
         START_CODE
            MOVE    1,I;
            CALLI   1,'400070;       COMMENT VDSMAP;
            JUMP    0,0;
         END;
      CAM←3;
      END;

   P2←0; WHILE 2↑P2<SUMS DO P2←P2+1;

      BEGIN "ARRAYS"
      INTEGER ARRAY T[1:NPX←REDUN*SUMS*2↑(BIT-4),0:PIXDIM(HIG,WID,4)];
      INTEGER ARRAY U[0:PIXDIM(HIG,WID,P2+BIT)], PIC[0:PIXDIM(HIG,WID,BIT)];

      MAKPIX(HIG,WID,BIT,PIC[0]);  MAKPIX(HIG,WID,BIT+P2,U[0]);

      TI←CALL(0,"RUNTIM");
      NSU←SUMS*2↑(BIT-4);
      FOR I←1 STEP 1 UNTIL NPX DO MAKPIX(HIG,WID,4,T[I,0]);

      NRT←0;  FOR I←1 STEP 1 UNTIL NPX DO
      NRT←NRT LOR TVRAW(CAM,YEE,XEE,T[I,0],BCL,TCL,NRTRY);

      HD[1]←JOBNO;
      HD[2]←LOCATION(MESSAGE[1]);

      START_CODE MAIL 0,ACCESS(HD[1]); comment SEND; JRST .+1; END;

      FOR I←1 STEP 1 UNTIL NPX DO TVGRY(T[I,0]);

      PRINT("  ",(IF NRT<0 THEN " aborted " ELSE
	     CVS(NRT)&" RETR"&(IF NRT≠1 THEN "IES" ELSE "Y")),'15&'12);
      PRINT((CALL(0,"RUNTIM")-TI)/1000," TO DIGITIZE",'15&'12);

      IF NRT≥0 THEN
	 BEGIN
	 INTEGER BST;
	 INTEGER ARRAY MTCH,RN[1:NPX,1:NPX];INTEGER ARRAY DIA[1:NPX];
      TI←CALL(0,"RUNTIM");
	 FOR I←1 STEP 1 UNTIL NPX-1 DO FOR J←I+1 STEP 1 UNTIL NPX DO
	    MTCH[I,J]←MTCH[J,I]←CMPPAD(T[I,0],T[J,0]);
      PRINT((CALL(0,"RUNTIM")-TI)/1000," TO COMPARE",'15&'12);
	 BST←1;
	 FOR I←1 STEP 1 UNTIL NPX DO
	    BEGIN
	    INTEGER II,JJ;
	    FOR II←1 STEP 1 UNTIL NPX DO
	       BEGIN
	       RN[I,II]←1;
	       FOR JJ←1 STEP 1 UNTIL II-1 DO IF MTCH[I,JJ]<MTCH[I,II]
		  THEN RN[I,II]←RN[I,II]+1 ELSE RN[I,JJ]←RN[I,JJ]+1;
	       END;
	    FOR II←1 STEP 1 UNTIL NPX DO IF RN[I,II]=NSU THEN
		  DIA[I]←MTCH[I,II];
	    IF DIA[I]<DIA[BST] THEN BST←I;
	    END;
	 FOR I←1 STEP 1 UNTIL NPX DO
	    BEGIN
	    PRINT(IF I=BST THEN "→" ELSE " ",DIA[I]%(2↑9*PIC[PCWD])," | ");
	    FOR J←1 STEP 1 UNTIL NPX DO PRINT(MTCH[I,J]%(2↑9*PIC[PCWD])," ");
	    PRINT('15&'12);
	    END;
	 PRINT(PIC[PCLN]," LINES x ",PIC[LNBY],
	    " BYTES/LINE x ",PIC[BYBI]," BIT/BYTE",'15&'12);
	 PRINT('15&'12);
	 FOR I←1 STEP 1 UNTIL NPX DO IF RN[BST,I]≤NSU THEN
		 PRINT(I," ");
	 PRINT('15&'12);

      TI←CALL(0,"RUNTIM");
	 FOR I←1 STEP 1 UNTIL NPX DO IF RN[BST,I]≤NSU THEN
	    PICADD(T[I,0],U[0]);
      PRINT((CALL(0,"RUNTIM")-TI)/1000," TO ADD",'15&'12);
	 END;

      TI←CALL(0,"RUNTIM");
      PICSH(U[0],PIC[0],SUMS);
      PRINT((CALL(0,"RUNTIM")-TI)/1000," TO DIVIDE",'15&'12);
      PUTPFL(PIC[0],FND&":"&FN1&"."&FN2&"["&FNP&","&FNR&"]");

      HD[1]←JOBNO;
      HD[2]←LOCATION(MESSAGE[1]);

      START_CODE MAIL 0,ACCESS(HD[1]); comment SEND; JRST .+1; END;

      END "ARRAYS";
   END "WAIT";
END;